home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / less.pm < prev    next >
Text File  |  2008-07-24  |  3KB  |  156 lines
  1. package less;
  2. use strict;
  3. use warnings;
  4.  
  5. our $VERSION = '0.02';
  6.  
  7. sub _pack_tags {
  8.     return join ' ', @_;
  9. }
  10.  
  11. sub _unpack_tags {
  12.     return grep { defined and length }
  13.         map  { split ' ' }
  14.         grep {defined} @_;
  15. }
  16.  
  17. sub of {
  18.     my $class = shift @_;
  19.  
  20.     # If no one wants the result, don't bother computing it.
  21.     return unless defined wantarray;
  22.  
  23.     my $hinthash = ( caller 0 )[10];
  24.     my %tags;
  25.     @tags{ _unpack_tags( $hinthash->{$class} ) } = ();
  26.  
  27.     if (@_) {
  28.         exists $tags{$_} and return !!1 for @_;
  29.         return;
  30.     }
  31.     else {
  32.         return keys %tags;
  33.     }
  34. }
  35.  
  36. sub import {
  37.     my $class = shift @_;
  38.  
  39.     @_ = 'please' if not @_;
  40.     my %tags;
  41.     @tags{ _unpack_tags( @_, $^H{$class} ) } = ();
  42.  
  43.     $^H{$class} = _pack_tags( keys %tags );
  44.     return;
  45. }
  46.  
  47. sub unimport {
  48.     my $class = shift @_;
  49.  
  50.     if (@_) {
  51.         my %tags;
  52.         @tags{ _unpack_tags( $^H{$class} ) } = ();
  53.         delete @tags{ _unpack_tags(@_) };
  54.         my $new = _pack_tags( keys %tags );
  55.  
  56.         if ( not length $new ) {
  57.             delete $^H{$class};
  58.         }
  59.         else {
  60.             $^H{$class} = $new;
  61.         }
  62.     }
  63.     else {
  64.         delete $^H{$class};
  65.     }
  66.  
  67.     return;
  68. }
  69.  
  70. 1;
  71.  
  72. __END__
  73.  
  74. =head1 NAME
  75.  
  76. less - perl pragma to request less of something
  77.  
  78. =head1 SYNOPSIS
  79.  
  80.     use less 'CPU';
  81.  
  82. =head1 DESCRIPTION
  83.  
  84. This is a user-pragma. If you're very lucky some code you're using
  85. will know that you asked for less CPU usage or ram or fat or... we
  86. just can't know. Consult your documentation on everything you're
  87. currently using.
  88.  
  89. For general suggestions, try requesting C<CPU> or C<memory>.
  90.  
  91.     use less 'memory';
  92.     use less 'CPU';
  93.     use less 'fat';
  94.  
  95. If you ask for nothing in particular, you'll be asking for C<less
  96. 'please'>.
  97.  
  98.     use less 'please';
  99.  
  100. =head1 FOR MODULE AUTHORS
  101.  
  102. L<less> has been in the core as a "joke" module for ages now and it
  103. hasn't had any real way to communicating any information to
  104. anything. Thanks to Nicholas Clark we have user pragmas (see
  105. L<perlpragma>) and now C<less> can do something.
  106.  
  107. You can probably expect your users to be able to guess that they can
  108. request less CPU or memory or just "less" overall.
  109.  
  110. If the user didn't specify anything, it's interpreted as having used
  111. the C<please> tag. It's up to you to make this useful.
  112.  
  113.   # equivalent
  114.   use less;
  115.   use less 'please';
  116.  
  117. =head2 C<< BOOLEAN = less->of( FEATURE ) >>
  118.  
  119. The class method C<< less->of( NAME ) >> returns a boolean to tell you
  120. whether your user requested less of something.
  121.  
  122.   if ( less->of( 'CPU' ) ) {
  123.       ...
  124.   }
  125.   elsif ( less->of( 'memory' ) ) {
  126.  
  127.   }
  128.  
  129. =head2 C<< FEATURES = less->of() >>
  130.  
  131. If you don't ask for any feature, you get the list of features that
  132. the user requested you to be nice to. This has the nice side effect
  133. that if you don't respect anything in particular then you can just ask
  134. for it and use it like a boolean.
  135.  
  136.   if ( less->of ) {
  137.       ...
  138.   }
  139.   else {
  140.       ...
  141.   }
  142.  
  143. =head1 CAVEATS
  144.  
  145. =over
  146.  
  147. =item This probably does nothing.
  148.  
  149. =item This works only on 5.10+
  150.  
  151. At least it's backwards compatible in not doing much.
  152.  
  153. =back
  154.  
  155. =cut
  156.